Analyse - Freie Berufe & Rente

Freie Berufe

Fragestellungen

Welcher Inflationsindex passt am besten zu den Daten?
Was fällt bei den verschiedenen Indizes auf?
Wie können die Unterschiede zwischen den Indizes erklärt werden?

Code

d |>
  filter(name == "Schadensbedarf") |> 
  ggplot(aes(Jahr, `Jährliche Inflation`, group = name)) +
  geom_line() +
  scale_y_continuous(labels = scales::dollar_format()) +
  labs(
    title = "Jährlicher Schadensbedarf"
    , x = NULL, y = NULL
  ) +
  theme(legend.position = "none")

Code

d |>
  filter(name != "Schadensbedarf") |> 
  ggplot(aes(Jahr, `Jährliche Inflation`, colour = name, group = name)) +
  geom_line() +
  facet_wrap(vars(name), scales = "free_y", ncol = 1) +
  scale_y_continuous(labels = scales::percent_format()) +
  labs(
    title = "Jährliche Inflation"
    , subtitle = "Veränderungsraten von 2013 bis 2023"
    , x = NULL, y = NULL
  ) +
  theme(legend.position = "none")

Code

d_raw |>
  transmute(
    Jahr = factor(Anfalljahr)
    , Schadensbedarf = `Historischer Schadenbedarf`
    , `Index A` = `Jährliche Inflation Index A` +1
    , `Index B` = `Jährliche Inflation Index B` +1
    , `Index C` = `Jährliche Inflation Index C` +1
  ) -> x

tribble(
  ~Jahr, ~Schadensbedarf, ~`Index A`, ~`Index B`, ~`Index C`
  , 2012, 0, 100, 100, 100
) |> mutate(Jahr = factor(Jahr)) |>
  bind_rows(x) |>
  transmute(
    Jahr
    , `Index A` = accumulate(`Index A`, `*`)
    , `Index B` = accumulate(`Index B`, `*`)
    , `Index C` = accumulate(`Index C`, `*`)
  ) |>
  pivot_longer(2:4, names_to = "Index", values_to = "Wert") |>
  ggplot(aes(Jahr, Wert, group = Index, colour = Index)) +
  geom_line() +
  facet_wrap(vars(Index), ncol = 1, scales = "free_y") +
  labs(
    title = "Jährliche Inflation"
    , subtitle = "Indizes von 2013 bis 2023, Basisjahr = 2012"
    , x = NULL, y = NULL
  ) +
  theme(legend.position = "none")

Indizes B und C haben einen sehr ähnlichen Verlauf (kolinear siehe unten)
Die Veränderungsraten von Index B und Index C kovairiieren auf den ersten Blick eher mit der Zeitreiehe des Schadenbedarfs als Index A
Als Index mit dem Basisjahr 2012 ergibt sich für Index B eine Steigerung von 22% über den Betrachtungszeitraum, dies deckt sich am ehesten mit der Veränderung von 33,1% in den Schadensbedarfen
Die Veränderung in Index A mit etwa 35% stimmt jedoch am ehesten mit der absoluten Zunahme in den Schadensbedarfen am Ende des Betrachtungszeitraums überein

Code

library(fpp3)

d_raw |> 
  rename(
    Schadensbedarf = `Historischer Schadenbedarf`
    , `Index A` = `Jährliche Inflation Index A`
    , `Index B` = `Jährliche Inflation Index B`
    , `Index C` = `Jährliche Inflation Index C`
  ) |> 
  GGally::ggpairs(2:5)

Indizes B und C sind perfekt kolinear
Paarweise Vergleiche zeigen hohe bivariate Korrelationen von Index B/C mit den jährlichen Schadensbedarfen
Index A korreliert negativ mit den Schadensbedarfen
Zur Abschätzung der marginalen Effekte wird eine einfache Multivariate Regression für Zeitreihen gerechnet (Einschränkungen durch geringe Stichprobengröße bei Interpretation berücksichtigen)
Schadensbedarfe haben scheinbar einen leichten positiven Trend, daher wird auch ein Modell mit einem trend() getestet

Code

fit_schaden <- d_raw |> 
  tsibble(index = Anfalljahr) |> 
  model(
    TSLM_AB = TSLM(`Historischer Schadenbedarf` ~  `Jährliche Inflation Index A` + `Jährliche Inflation Index B`)
    , TSLM_AB_Trend = TSLM(`Historischer Schadenbedarf` ~ trend() + `Jährliche Inflation Index A` + `Jährliche Inflation Index B`)
    , TSLM_B_Trend = TSLM(`Historischer Schadenbedarf` ~ trend() + `Jährliche Inflation Index B`)
    , TSLM_B = TSLM(`Historischer Schadenbedarf` ~ `Jährliche Inflation Index B`)
    )

glance(fit_schaden) |> 
  transmute(Model = .model, adj_r_squared, CV, AIC, AICc, BIC) |> 
  knitr::kable()

Model	adj_r_squared	CV	AIC	AICc	BIC
TSLM_AB	0.2928033	3656.398	81.12025	87.78692	82.71183
TSLM_AB_Trend	0.4242795	3119.866	79.38886	91.38886	81.37833
TSLM_B_Trend	0.3764999	1103.674	79.73469	86.40136	81.32628
TSLM_B	0.2975563	1225.040	80.34169	83.77026	81.53537

Code

fit_schaden_final <- d_raw |> 
  tsibble(index = Anfalljahr) |> 
  model(
    tslm = TSLM(`Historischer Schadenbedarf` ~ `Jährliche Inflation Index B`)
    )
report(fit_schaden_final)

Series: Historischer Schadenbedarf 
Model: TSLM 

Residuals:
    Min      1Q  Median      3Q     Max 
-47.393 -17.216   1.905  15.488  61.180 

Coefficients:
                              Estimate Std. Error t value Pr(>|t|)   
(Intercept)                     114.33      26.09   4.382  0.00177 **
`Jährliche Inflation Index B`  2999.13    1310.68   2.288  0.04791 * 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 32.44 on 9 degrees of freedom
Multiple R-squared: 0.3678, Adjusted R-squared: 0.2976
F-statistic: 5.236 on 1 and 9 DF, p-value: 0.047913

Code

gg_tsresiduals(fit_schaden_final)

Gesamtheitliche Betrachtung der Informationskriterien zeigt, dass ein Modell nur mit Index B zu bevorzugen ist, auch wenn R² dadurch nicht maximiert wird
Ein Trend verbessert die Varianzaufklärung, ist jedoch insbesondere unter Berücksichtigung des AICc keine bedeutende Ergänzung für das Modell
Vergleiche der Modelle zeigen damit auch keinen zusätzlichen Informationszugewinn durch das Einbeziehen von Index A

Index B bildet insgesamt zwar nicht den gesamten Effekt in der Entwicklung der Schadensbedarfe ab, jedoch wäre er basierend auf den verfügbaren Informationen ein vielversprechender Prädiktor.

TODO: haben wir in Zeitreihe A einen Outlier und wie würde dies die Ergebnisse verändern?

Renten

Fragestellungen

Welche zusätzliche Information lassen sich aus den vorhandenen Daten ableiten?
Welche Auffälligkeiten oder Zusammenhänge lassen sich im Datensatz finden?

Datensatz

Vorhandene Features

Index
Höhe der (monatlichen?) Rentenauszahlung
Rentenbeginn (Datum ¹)
Rentenende (Datum ²)
Geburtsdatum (Datum ³)
Geschlecht (2, 1, NA)
Segment
Adresse

Neue Features

Alle Datumswerte ISO-Konvertiert (Origin = 1899-12-30 UTC)
Geburtsjahr
Rentendauer (bei vorhandendem Enddatum)
Alter bei Rentenbeginn
Alter bei Rentenende
Alter heute (05.11.2024)
Rentenmonate (bis zum 05.11.2024)
Adresskomponenten (Straße, Hausnummer, PLZ, Ort)
Summe der bisher ausgezahlten (monatlichen) Rente

Überblick

Einige Extremwerte in der Höhe der Rentenauszahlung (TODO: leaverage?)
499 der 600 Einträge entfallen auf das Segment Unfall
Der Rest enfällt auf Kraftfahrthaftpflicht (n = 64) und Heilwesenhaftpflicht (n = 25)
Sehr wenige Fälle für Privathaftpflicht (n = 3) und Betriebshaftpflicht (n = 9)

Code

x <- d |>
  filter(Renten_Auszahlung < 30000
         , !is.na(Geschlecht)
         , Segment %in% c("Unfall", "Kraftfahrthaftpflicht", "Heilwesenhaftpflicht")
         , ) |>
  select("Renten_Auszahlung", "Geschlecht", "Segment", "Geburtsjahr", "Rente_Beginn_Alter") #


GGally::ggpairs(x, mapping = aes(colour = Segment, alpha = 0.5))

Geschlecht

Kein Schlüssel für Zuordnung vorgegeben, Kodierung nach ISO/IEC 5218 angenommen
Beide Ausprägungen etwa gleich häufig vorhanden
Fünf fehlende Werte
Keine großen Effekte zwischen den Geschlechtern (geringer als erwartet)

TODO: GGally nach Geschlecht

Code

d |> 
  filter(Segment == "Unfall") |> 
  summarise(mean= mean(Renten_Auszahlung), median = median(Renten_Auszahlung), n = n(), .by = Geschlecht)

# A tibble: 3 × 4
  Geschlecht  mean median     n
  <fct>      <dbl>  <dbl> <int>
1 Weiblich   2822.  1602.   246
2 Männlich   2591.  1443.   250
3 <NA>       1064.  1034.     3

Ort

1:1 Beziehung zwischen Ort und PLZ
16 Orte/PLZ
Sehr viele Fälle aus Berlin, Hannover, Hamburg und München (zusammen n = 417)
Kein erkennbares Muster in Strßenverteilung

Code

library(ggridges)
d |>
  ggplot(aes(x = Renten_Auszahlung, Ort, fill = Ort)) +
  geom_density_ridges(alpha = 0.3) +
  geom_point(position = "jitter", alpha = 0.2, aes(color = Ort)) +
  theme_ridges() +
  theme(legend.position = "none") +
  labs(x = NULL, y = NULL, title = "Verteilung der Rentenauszahlungen pro Stadt")
d |>
  count(Strasse, sort = T) |>
  ggplot(aes(x = n, y = Strasse)) +
  geom_point() +
  lims(x = c(0, 40))+
  labs(x = NULL, y = NULL, title = "Häufigkeit der Straßennamen")

Verteilung Rentenauszahlung

Verteilung der Renten sind log-normal

Code

d |>
  transmute(
    Renten_Auszahlung
    , Renten_Auszahlung_log = log(Renten_Auszahlung)
  ) |>
  ggplot(aes(Renten_Auszahlung_log)) +
  geom_histogram(bins = 45, fill = "darkgreen", color = "lightgray")

Kummulierte Rentenauszahlungen

Keine Sterbeinformation
Hinterlegte Rentenenddaten liegen fast ausschließlich in der Zukunft
Korrektur für Inflation (Daten für Verbraucherpreisindex nur bis 1992)
Annahmen
- Jährliche Anpassung der Renten (alleinig) basierend auf Verbraucherpreisindex
- Rentenauszahlung erfolgt monatlich
- Auszahlungen in €
Seit 1992 wurden etwa 432 Mio. € ausgezahlt (477 Mio. € ohne Anpassung)

Code

# Korrektur für Inflation?
Rentenzahlungen_ts <- d |>
  filter(year(Rente_Beginn_Datum) > 1991) |>
  transmute(
    Renten_Auszahlung, Rente_Beginn_Datum = yearmonth(Rente_Beginn_Datum)
    , Datum_Zwischenstand = yearmonth("2024-11-05")
  ) |>
  rownames_to_column("id") |>
  pivot_longer(cols = c(Rente_Beginn_Datum, Datum_Zwischenstand)) |>
  as_tsibble(index = value, key = id) |>
  tsibble::fill_gaps() |>
  tidyr::fill(Renten_Auszahlung, .direction = "down") |>
  select(-name)

CPI <- readxl::read_excel("../data/verbraucherpreisindex-lange-reihen-xlsx-5611103.xlsx"
                   , sheet = "CPI")
Inflation <- CPI |>
  mutate(
    Jahr = parse_number(Jahr)
    , Index = Index / 100
  )

Rentenzahlungen_ts |>
  as_tibble() |>
  mutate(Jahr = year(value)) |>
  left_join(Inflation, by = "Jahr") |>
  tidyr::replace_na(
    list(Index = 1) # keine Daten für 2023, 2024
  ) |>
  transmute(
    value #, id
    , Renten_Auszahlung
    , Renten_Auszahlung_ib = Renten_Auszahlung * Index
  ) |>
  group_by(value) |>
  dplyr::summarise(Renten_Auszahlung = sum(Renten_Auszahlung)
            , Renten_Auszahlung_ib = sum(Renten_Auszahlung_ib)
             ) |>
  ggplot(aes(value)) +
  geom_line(aes(y = Renten_Auszahlung), colour = "darkgreen") +
  geom_line(aes(y = Renten_Auszahlung_ib, colour = "darkred")) +
  theme(legend.position = "none") +
  scale_y_continuous(labels = scales::dollar_format(prefix = "€")) +
  labs(x = NULL, y = NULL,
       title = "Monatliche Rentenauszahlungen"
       , subtitle = "Inflationsanpassung in Rot")

Rentenbeginn

Große Unterschiede zwischen den Segmenten
Keine eindeutige Saisonalität (Monat/Quartal)
Unfall 2011: Änderungen in der gesetzlichen Altersrente
Zeitliche Häufung ggf. auf unterschiedliche Produkte zurückführbar (z.B. Heilwesen: hier hat HDI deutlich längere Erfahrung)

Code

pl1 <- d |>
  select(Rente_Beginn_Datum, Segment) |>
  transmute(
    ym = year(Rente_Beginn_Datum)
    , Segment
  ) |>
  count(ym, Segment) |>
  tsibble(index = ym, key = Segment) |>
  autoplot() |> 
  plotly::ggplotly()

pl1

Rentenbeginn und Alter

Unterschiedlichen Verteilungen pro Segment
Drei Fälle, bei denen der Rentenbeginn z.T. mehrere Jahre vor der Geburt liegt
Unfallrente beginnt hier häufig erst (vermeintlich) mit der gesetzlichen Altersrente, jedoch zunehmend im höheren Alter
Rentenbeginn für die Haftpflicht-Segmente liegt fast ausnahmslos unterhalb des gesetzlichen Rentenalters
Betriebs- und Privathaftpflicht nicht interpretierbar

Code

pl2 <- d |>
  ggplot(aes(Rente_Beginn_Datum, Rente_Beginn_Alter, colour = Segment)) +
  geom_point() +
  geom_abline(slope = 0, intercept = 0, colour = "lightgray") 


pl2 <-   plotly::ggplotly(pl2)

pl2

Rentenende

Enddatum für die Rente ist nur in 33 Fällen hinterlegt
Fast ausschließlich für Kraftfahrthaftpflicht (n = 24) und nie im Segment Unfall
Alter zum hinterlegten End-Zeitpunkt ist für KF- und Privat- Haftpflicht zum Zeitpunkt des vermeitlichen Beginns der gesetzlichen Altersrente
Alter zum Rentenenddatum bei der Heilwesenhaftpflicht deutlich niedriger (regelmäßige Überprüfung?)

Code

d |>
  ggplot(aes(Rente_Ende_Alter)) +
  geom_histogram(bins = 20, aes(fill = Segment))

Code

# Bei diesen Renten (alle nich-Unfall) - wird die Rente nur bis zum (voraussichtlichen)
# Entrittsdatum der gesetzlichen Altersrente gezahlt, da es sich um eine Rente zum Ausgleich
# des Verdienstausfalls handelt
# Frage: was ist bei den Haftpflicht-Renten anders, welche kein Enddatum hinterlegt haben?
#     --> haben sich ggf. schon in Rente befunden?
#
# KF-Haftpflicht: alle in der gleichen PLZ, allerdings untersch. Straßen

Alter

Errechnetes heutiges Alter (05.11.2024)
Sehr große Anzahl an Personen über 90 und über 100 Jahre (Markierung)
Fehlen ggf. Sterbedaten

Code

d |> ggplot(aes(Alter_heute)) +
  geom_histogram() +
  geom_vline(xintercept = 100)

Ausreißer

Für vertiefte zukünftige Analysen
Fünf Einträge ohne Geschlecht
Sehr hohe Rentenauszahlungen
Sehr alte Personen (Sterbedaten verfügbar?)

Fragen

Gibt es Haftpflichtrenten, bei denen das Enddatum fehlt und die schon vom Alter über die Rentengrenze sind? Was ist bei denen anders?

Footnotes

alle Daten im Excel-Datumsformat angeliefert↩︎
alle Daten im Excel-Datumsformat angeliefert↩︎
alle Daten im Excel-Datumsformat angeliefert↩︎